home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xlib / track < prev    next >
Encoding:
Text File  |  1992-07-20  |  1.0 KB  |  39 lines
  1. ;;; -*-Scheme-*-
  2.  
  3. (require 'xlib)
  4.  
  5. (define (track)
  6.   (let* ((dpy (open-display))
  7.      (root (display-root-window dpy))
  8.      (gc (create-gcontext 'window root
  9.                 'function 'xor
  10.                 'foreground (black-pixel dpy)
  11.                 'subwindow-mode 'include-inferiors))
  12.      (where (query-pointer root))
  13.      (lx (car where)) (ly (cadr where)) (lw 300) (lh 300)
  14.      (move-outline
  15.       (lambda (x y)
  16.         (if (not (and (= x lx) (= y ly)))
  17.         (begin
  18.           (draw-rectangle root gc lx ly lw lh)
  19.           (draw-rectangle root gc x y lw lh)
  20.           (set! lx x) (set! ly y))))))
  21.     (unwind-protect
  22.      (case (grab-pointer root #f '(pointer-motion button-press)
  23.              #f #f 'none 'none 'now)
  24.        (success
  25.     (with-server-grabbed dpy
  26.       (draw-rectangle root gc lx ly lw lh)
  27.       (display-flush-output dpy)
  28.       (handle-events dpy #t #f
  29.         (motion-notify
  30.          (lambda (event root win subwin time x y . rest)
  31.            (move-outline x y) #f))
  32.         (else (lambda args #t)))))
  33.        (else
  34.     (format #t "Not grabbed!~%")))
  35.        (draw-rectangle root gc lx ly lw lh)
  36.        (close-display dpy))))
  37.  
  38. (track)
  39.